#!/usr/bin/perl
#
use strict;
use Data::Dumper;
use CGI qw(:standard);
use Data::Validate::URI qw(is_http_uri);
use HTML::TreeBuilder;
use HTML::TagFilter;
use Text::Language::Guess;
use HTML::Entities;
use Text::Unidecode;
# Could use the following library to filter out images that are too small to bother keeping
use Image::Info qw(image_info dim);

# todo: handle LWP timeout.

# CONFIGURATION
#
my $PDFToText='/usr/X11R6/bin/pdftotext';
my $PDFInfo='/usr/X11R6/bin/pdfinfo';
my $PDFImages='/usr/X11R6/bin/pdfimages';

my $tree=HTML::TreeBuilder->new;

my $guesser = Text::Language::Guess->new();


# Create a user agent object
use LWP::UserAgent;
use Digest::MD5 qw(md5 md5_hex md5_base64);

my $ua = LWP::UserAgent->new;
$ua->agent("pdfAssay/0.1 ");



sub is_pdf($){
	my $linky=shift;
	open(FHANDLE,"./cache/".md5_hex($linky)) or die "Couldn't open file";
	my $status;
	my $firstline=<FHANDLE>;
	my $magicno="%PDF";
	my $hex = unpack 'H*', $firstline;
	my $magichex = unpack 'H*', $magicno;
	my @ahex=$hex=~/../g;
	my @amagichex=$magichex=~/../g;
	my $isequal=0;
	for(my $i=0;$i<length(@amagichex);$i++){
		if($amagichex[$i] != $ahex[$i]){
			$isequal=-1;	
		}
	}
	close(FHANDLE);
	return $isequal;
}

sub round_it {
	my $num = shift;
	my $gb = (1024 * 1024 * 1024);
	my $mb = (1024 * 1024);
	my $kb = 1024;

	($num > $gb) ? return sprintf("%dGB", $num/$gb) :
	($num > $mb) ? return sprintf("%dMB", $num/$mb) :
	($num > $kb) ? return sprintf("%dKB", $num/$kb) :
	return $num . 'B';
}


sub count_words ($){
	my $words=shift;
	my @wordarr = split(/\W+/,$words);
	#add_to_log($#wordarr);
	return $#wordarr;
}

sub get_clean_content($){
	my $content=shift;
	my $tf = new HTML::TagFilter(allow=>{ p => { none=> []} });
	my $clean_content=$tf->filter($content);
	return $clean_content
}
sub add_to_log($){
	my $addme=shift;
	open(LOGFILE,">>./logfile");
	print LOGFILE $addme;
	close(LOGFILE);
}

sub get_word_count($){
	my $content=shift;
	my $contents=get_clean_content($content);
	return count_words($contents);	
}

sub is_cached($){
	my $url=shift;
	my $urlhash=md5_hex($url);
	my $write_secs = (stat("./cache/$urlhash"))[9];
	#   printf "file %s updated at %s\n", $file,
	my $readableage= scalar localtime($write_secs);
	print LOGFILE "File age $write_secs $readableage\n";
	close(LOGFILE);
	# if file exists & file's relatively recent 
	if ( -e "./cache/$urlhash" && -M "./cache/$urlhash" < 0.01){
		return 1;
	} elsif ( -M "./cache/$urlhash" >= 0.01){
		rename("./cache/$urlhash","./cache/$urlhash.$write_secs");
		# not deleting but moving the older files
		return -1;

	} else {
		return -1;
	}

}

sub image_evaluator($){
	my $image=shift;
	$image=~/\.(\w\w\w)$/;
	my $extension=$1;
	
	return 0;
}

sub strip_invalid_text($){
	my $str=shift;
	#The complete regex for removal of invalid xml-1.0 characters is:

	# #x9 | #xA | #xD | [#x20-#xD7FF] | [#xE000-#xFFFD] | [#x10000-#x10FFFF]
	$str =~ s/[^\x09\x0A\x0D\x20-\x{D7FF}\x{E000}-\x{FFFD}\x{10000}-\x{10FFFF}]//go;
	#
	# for xml-1.1 it is:
	#
	# # allowed: [#x1-#xD7FF] | [#xE000-#xFFFD] | [#x10000-#x10FFFF]
	$str =~ s/[^\x01-\x{D7FF}\x{E000}-\x{FFFD}\x{10000}-\x{10FFFF}]//go;
	# # restricted:[#x1-#x8][#xB-#xC][#xE-#x1F][#x7F-#x84][#x86-#x9F]
	$str =~    s/[\x01-\x08\x0B-\x0C\x0E-\x1F\x7F-\x84\x86-\x9F]//go;
	# replace short hyphen character (decimal 173)
	$str=~ s/\173/-/g;
	
	$str=unidecode($str);
	# give up, remove the lot?
	$str =~ s/(.)/(ord($1) > 127) ? "" : $1/egs;
	$str=~tr/\000-\037/ /;    # best option for speed
	$str=~s/</&lt;/g;
	$str=~s/>/&gt;/g;

	return $str;
}

sub get_webpage($){
	my $linky=shift;
	if(is_cached($linky)>-1){
		#retrieve from local cache
		my $thelink="./cache/";
		$thelink=$thelink.md5_hex($linky);
		my $req=HTTP::Request->new(GET=> "file:$thelink");
  		# Pass request to the user agent and get a response back
  		my $res = $ua->request($req);
  		if ($res->is_success) {
			return $res;
		} else {
			# Something unlikely went wrong - I mean the file was here just a minute ago :-(
			print "<Error xmlns=\"urn:ukoln:api\"><Message>Temporary internal error</Message></Error>";
		}
	} else {
  		# Let's try to connect to it and see what happens 
  		my $req = HTTP::Request->new(GET => $linky);
  		# Pass request to the user agent and get a response back
  		my $res = $ua->request($req);

		# Cache it!	
  		if ($res->is_success) {
			# Write (>) rather than append (>>)
			open(FHANDLE,">./cache/".md5_hex($linky));
			print FHANDLE $res->content;
			close(FHANDLE);
		}
		# return the object
		return $res;
	}
}
sub imageSize{
	my $imagelink=shift;
	$imagelink=~/\.(\w\w\w)$/;
	my $imageext=$1;
	my @returnarr;
	# Actually the image::info seems fine with everything except pbm
	# so should possibly do the pbm one manually
	if($imageext eq 'pbm'){
		# take a look in the file
		# get second line of file
		@returnarr=("0","0");
		open(FILEHANDLE,$imagelink) or return @returnarr; 
		my $firstline=<FILEHANDLE>;
		my $secondline=<FILEHANDLE>;	
		close(FILEHANDLE);
		if (defined $secondline){
		       if ($secondline=~/(\d+)\ (\d+)/){
			       #print "$1 $2\n";
			       @returnarr=($1,$2);
			       return @returnarr;
		       }
	       }

	} else {
		my $info=image_info($imagelink);

		if (my $error = $info->{error}) {
			#die "Can't parse image info: $error\n";
			print "Could not parse image\n";
			@returnarr=("0","0");
			return @returnarr;
		} else {
			my @dim=dim($info);
			#print Data::Dumper->Dump([@dim]);	
			@returnarr=@dim;
			return @returnarr;
		}
	}

}

my @queries = split(/&/,$ENV{QUERY_STRING});

my $ishandled=0;
# you call this script by /pdfAssay/=/link/http://link
if($ENV{'PATH_INFO'}=~/^\/=\/link\/(.*)/ || $ARGV[0]){
	my $linky=$1;
	print "Content-Type: text/xml\n\n";
	if($ARGV[0]){
		$linky=$ARGV[0];
	}
	
	my $tochecklinky=$linky;
	$tochecklinky=~s/^https/http/;
	print "<?xml version=\"1.0\" encoding=\"UTF-8\"?>\n";
	my $myself=$ENV{'SERVER_NAME'}.$ENV{'SCRIPT_NAME'};
	if(is_http_uri($tochecklinky)){
  		# Let's try to connect to it and see what happens 
		my $res=get_webpage($linky);
		my $cacheid="./cache/".md5_hex($linky);
		my $md5sum=md5_hex($linky);
  		# Check the outcome of the response
  		if ($res->is_success) {
		 	# Now that we have the page (actually a PDF file, we hope)?
		 	# let's see if it's a PDF ("%PDF" (25 50 44 46))
		 	my $isequal=is_pdf($linky);
			if($isequal<0){
				print "<Error xmlns=\"urn:ukoln:api\"><Message>File at ".$linky." does not appear to be a PDF</Message></Error>";
			} else {
				# Fine, it's a PDF; now what? Call PDFInfo on it!	
				my @pdfinfores=`$PDFInfo $cacheid 2>&1`;
				my @pdftotext=`$PDFToText $cacheid - 2>&1`;
				my $imagedir="$cacheid-images";
				`mkdir $imagedir 2>&1`;
				my @pdfimage=`$PDFImages -j  $cacheid $imagedir/img 2>&1`;
				my @imagefiles = <$imagedir/*>;

				my %pdfinfohash;
				# Would be a good idea to strip numeric-only stuff, punctuation, etc out of wordsintext
				# or use a real tokeniser instead of this guess
				my $wordsintext=join(/ /,@pdftotext);
				my $fulltext=strip_invalid_text(join(/\n/,@pdftotext));
				my @imagecaptions;
				# the text from pdftotext needs to be preprocessed to correct flow, etc.
				foreach my $line (@pdftotext){
					if($line=~/Fig(ure)?(\ ? \d+\ ?[:|.|-]\ ?\w.*?)\n/i){
						# should limit the output of this, say, to five sentences
						my $tmpcaption=strip_invalid_text($2);
						push(@imagecaptions,"<![CDATA[ Fig$tmpcaption ]]>");
					}
				}	
				my @imagefilelinks;
				foreach my $line (@imagefiles){
					if($line=~/\.\w\w\w\.\w\w\w$/){
					} else {
						my @dims=imageSize($line);
						# Check image size before deciding whether to keep it
						if($dims[0]>10 && $dims[1]>10){
							$line=~s/.\/cache\///;
							push(@imagefilelinks,$myself."/=/retrieve/$line");
						}
					}
				}
				my $imagefilecount=@imagefilelinks;
				push(@{$pdfinfohash{'ImageTempURI'}},@imagefilelinks);
				print "<ResultSet>\n<Result>\n";
				$pdfinfohash{'Image file count'}="$imagefilecount";
				foreach my $line(@pdfinfores){
					chomp $line;
					$line=~/(.*?):(.*)/;
					my $key=$1;
					my $value=$2;
					$value=~s/^\s+//;
					$value=~s/\s+$//;
					$pdfinfohash{$key}=$value;
				}
				push(@{$pdfinfohash{'ImageCaptions'}},@imagecaptions);
				if(length($wordsintext)>120){ # probably enough words to guess at language?
					$pdfinfohash{'Language guessed'}=$guesser->language_guess_string($wordsintext);
				}
				if($pdfinfohash{'File size'}){
					my $filesize=$pdfinfohash{'File size'};	
					$filesize=~s/ bytes//;
					$pdfinfohash{'File size in bytes'}=$filesize;
					$pdfinfohash{'File size-human-readable'}=round_it($filesize);
					#print $filesize;
					my $averagepagesize=sprintf('%i',$filesize/$pdfinfohash{'Pages'});
					$pdfinfohash{'Average page size'}=$averagepagesize;
				}
				$pdfinfohash{'MD5'}=md5_hex($linky);
				$pdfinfohash{'FullText'}="<![CDATA[ $fulltext ]]>";
				my $removelinkheader=param('Remove_Prefix');
				my $tmplinky=$linky;
				$tmplinky=~s/^http:\/\///;
				$tmplinky=~s/^$removelinkheader//;
				if($tmplinky!=~/^http/){
					$tmplinky="http://$tmplinky";
				}
				$pdfinfohash{'Repository_PDF_Link'}=$tmplinky;
				my $inputrepsource=param('Repository_Source');
				if($inputrepsource){
					$pdfinfohash{'Repository_Source'}="$inputrepsource";
				}
				my $shorttmplinky=$tmplinky;
				$shorttmplinky=~/(http:\/\/.[^\/]*\/)(.*)/;
				my $rootaddy=$1;
				my $firstext=$2;
				if($firstext=~/^(\d+)/){
					$firstext=$1
				}
				$pdfinfohash{'Repository_Root'}="$rootaddy";
				$pdfinfohash{'Repository_Page'}="$rootaddy$firstext";
				$pdfinfohash{'Wordcount'}=count_words($wordsintext);
				foreach my $line(sort keys %pdfinfohash){
					my $showline=$line;
					$showline=~s/\ /-/g;
					print "<$showline>";
					if(ref $pdfinfohash{$line} eq 'ARRAY'){

						my @arr=@{$pdfinfohash{$line}};
						foreach my $entry (@arr){
							print "\n<$showline-entry>";
							print $entry;
							print "</$showline-entry>\n";
						}

					} elsif (ref $pdfinfohash{$line} eq 'HASH'){

					} else {
						print $pdfinfohash{$line};
					}
					print "</$showline>\n";
				}
				print "</Result>\n</ResultSet>\n";
			
			}
			#$hex2 = join ' ', $hex2 =~ /../g;
  		} else {
			print "<Error xmlns=\"urn:ukoln:api\"><Message>Could not access link: ".$res->status_line."</Message></Error>";
  		}
	} else {
		print "<Error xmlns=\"urn:ukoln:api\"><Message>String is not a link to a web page</Message></Error>";
	
	}
	$ishandled=1
}elsif($ENV{'PATH_INFO'}=~/^\/=\/retrieve\/(.*)/){
 	my $taintedlink=$1;

	if($taintedlink=~/^[a-f0-9]{32}-images\/img-\d+.(\w\w\w)/){
		my $extension=$1;
		if($1 eq 'jpg'){
			print "Content-Type: image/jpg\n\n";
		
		} elsif ($1 eq 'png'){
		 	print "Content-Type: image/png\n\n";      

		}elsif ($1 eq 'ppm' || $1 eq 'pbm') {
			`convert cache/$taintedlink cache/$taintedlink.png`;
			$taintedlink="$taintedlink.png";
			print "Content-Type: image/png\n\n";
			#print "<?xml version=\"1.0\" encoding=\"UTF-8\"?>\n";
			#print "<Error xmlns=\"urn:ukoln:api\"><Message>Your browser cannot display this content type $taintedlink.</Message></Error>";
			#exit();

		} else {
			print "Content-Type: text/xml\n\n";
			print "<?xml version=\"1.0\" encoding=\"UTF-8\"?>\n";
			print "<Error xmlns=\"urn:ukoln:api\"><Message>Your browser cannot display this content type.</Message></Error>";
			exit();
		}
		#print "The link is:". $taintedlink;
		open(FILEHANDLE,"./cache/".$taintedlink) or die "<Error xmlns=\"urn:ukoln:api\"><Message>This interface should be called in the following manner: /pdfAssay/=/retrieve/cached-image-identifier. Please see fixrep.ukoln.ac.uk for further information.</Message></Error>";
		 binmode STDOUT;
		binmode (FILEHANDLE);
		my $buffer;
		my ($data,$n,$offset);
		while (($n = read FILEHANDLE, $data, 4) != 0) {  $buffer .= $data; } 
		close FILEHANDLE;
		print $buffer;
	} else {
		print "Content-Type: text/xml\n\n";
		print "<Error xmlns=\"urn:ukoln:api\"><Message>This interface should be called in the following manner: /pdfAssay/=/retrieve/cached-image-identifier. Please see fixrep.ukoln.ac.uk for further information.</Message></Error>";

	}
		
}else{
		print "Content-Type: text/xml\n\n";
		print "<Error xmlns=\"urn:ukoln:api\"><Message>This interface should be called in the following manner: /pdfAssay/=/link/http://example.com/link-to-file.pdf. Please see fixrep.ukoln.ac.uk for further information.</Message></Error>";

}




